Option Explicit
Sub F_Sample040()
   'Microsoft ActiveX Data Objects 2.X Library ]wޥζ
   'Microsoft ADO Ext. 2.1 for DDL and Security ]wޥζ
   'ոF_Data.mdb
    Dim myCon     As New ADODB.Connection
    Dim myCat     As New ADOX.Catalog
    Dim myCmd     As ADODB.Command
    Dim myView    As ADOX.View
    Dim myProc    As ADOX.Procedure
    Dim myPrp     As ADODB.Property
    Dim i As Long
    Dim j As Long
    Dim myFileName As String
    myFileName = "F_Data.mdb"           'wɮצW
    myCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\" & myFileName & ";"
    Set myCat.ActiveConnection = myCon
    Worksheets.Add                  'sWu@
    'wDC
    Cells(1, 1).Resize(, 4).Value = _
          Array("QRY_NAME", "prp_NAME", "TYP", "VALUE")
    i = 2
    For Each myView In myCat.Views
        With myView
        Set myCmd = .Command
            Cells(i, 1).Resize(, 2).Value = Array(.Name, myCmd.CommandType)
        End With
        i = i + 1
        j = 1
        For Each myPrp In myCmd.Properties
            With myPrp
                If .Name <> "SQL" Then
                    Cells(i, 1).Resize(, 3).Value = _
                        Array(j, .Name, GetConstStr_ADO(.Type))
                    On Error Resume Next
                    Cells(i, 4).Value = .Value
                    On Error GoTo 0
                    i = i + 1: j = j + 1
                End If
            End With
        Next myPrp
        i = i + 1
    Next myView
    For Each myProc In myCat.Procedures
        With myProc
        Set myCmd = .Command
            Cells(i, 1).Resize(, 2).Value = Array(.Name, myCmd.CommandType)
        End With
        i = i + 1
        j = 1
        For Each myPrp In myCmd.Properties
            With myPrp
                If .Name <> "SQL" Then
                    Cells(i, 1).Resize(, 3).Value = _
                        Array(j, .Name, GetConstStr_ADO(.Type))
                    On Error Resume Next
                    Cells(i, 4).Value = .Value
                    On Error GoTo 0
                    i = i + 1: j = j + 1
                End If
            End With
        Next myPrp
        i = i + 1
    Next myProc
    Columns("A:D").AutoFit                  'e۰ʽվ
    myCon.Close
    Set myPrp = Nothing                 '
    Set myView = Nothing
    Set myProc = Nothing
    Set myCmd = Nothing
    Set myCat = Nothing
    Set myCon = Nothing
End Sub
Function GetConstStr_ADO(myInt As Integer) As String
    Dim myStr As String
    Select Case myInt
        Case 20: myStr = "adBigInt"
        Case 128: myStr = "adBinary"
        Case 11: myStr = "adBoolean"
        Case 8: myStr = "adBSTR"
        Case 136: myStr = "adChapter"
        Case 129: myStr = "adChar"
        Case 6: myStr = "adCurrency"
        Case 7: myStr = "adDate"
        Case 133: myStr = "adDBDate"
        Case 134: myStr = "adDBTime"
        Case 135: myStr = "adDBTimeStamp"
        Case 14: myStr = "adDecimal"
        Case 5: myStr = "adDouble"
        Case 0: myStr = "adEmpty"
        Case 10: myStr = "adError"
        Case 64: myStr = "adFileTime"
        Case 72: myStr = "adGUID"
        Case 9: myStr = "adIDispatch"
        Case 3: myStr = "adInteger"
        Case 13: myStr = "adIUnknown"
        Case 205: myStr = "adLongVarBinary"
        Case 201: myStr = "adLongVarChar"
        Case 203: myStr = "adLongVarWChar"
        Case 131: myStr = "adNumeric"
        Case 138: myStr = "adPropVariant"
        Case 4: myStr = "adSingle"
        Case 2: myStr = "adSmallInt"
        Case 16: myStr = "adTinyInt"
        Case 21: myStr = "adUnsignedBigInt"
        Case 19: myStr = "adUnsignedInt"
        Case 18: myStr = "adUnsignedSmallInt"
        Case 17: myStr = "adUnsignedTinyInt"
        Case 132: myStr = "adUserDefined"
        Case 204: myStr = "adVarBinary"
        Case 200: myStr = "adVarChar"
        Case 12: myStr = "adVariant"
        Case 139: myStr = "adVarNumeric"
        Case 202: myStr = "adVarWChar"
        Case 130: myStr = "adWChar"
        Case Else: myStr = "Error"
    End Select
    GetConstStr_ADO = myStr
End Function



